#include "FiveWin.ch"
#include "Visual.ch"
#include "Font.ch"

#define BAR_TOP         1
#define BAR_LEFT        2
#define BAR_RIGHT       3
#define BAR_DOWN        4
#define BAR_FLOAT       5

#translate DRIVERS(<x,...>)  => {<(x)>}

#ifdef __XPP__
   #define Super ::TWindow
#endif

memvar oIDE

static aDbfBmps

function GetWndAreas() ; return nil

//----------------------------------------------------------------------------//

function DbfNew( oMruDbfs )

   local oDlg, oGet, oType, oLen, oDec, oLbx, oBtnAdd, oBtnEdit, oCbx
   local cName    := Space( 10 )
   local cType    := "C"
   local nLen     := 10
   local nDec     :=  0
   local cField   := Space( 20 )
   local cTypes   := "CNLDM"
   local aLens    := { 10, 10, 1, 8, 8 }
   local cDbfName := Space( 12 )
   local lEditing := .f.
   local cDriver  := "DbfNtx"


   DEFINE DIALOG oDlg RESOURCE "DbfBuild"

   REDEFINE GET oGet VAR cName ID 110 OF oDlg

   REDEFINE COMBOBOX oType VAR cType  ITEMS { "C", "N", "L", "D", "M" } ;
      ON CHANGE ( nLen := aLens[ At( cType, cTypes ) ], oLen:Refresh() );
      ID 120 OF oDlg

   REDEFINE GET oLen VAR nLen PICTURE "9999" ID 130 OF oDlg

   REDEFINE GET oDec VAR nDec PICTURE "9"    ID 140 OF oDlg

   REDEFINE BUTTON oBtnAdd ID 150 OF oDlg ;
      ACTION AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
                       @cName, cType, nLen, nDec, @lEditing )

   REDEFINE BUTTON ID 160 OF oDlg ACTION oDlg:End()

   REDEFINE LISTBOX oLbx VAR cField ID 170 OF oDlg

   REDEFINE BUTTON oBtnEdit ID 180 OF oDlg ;
      ACTION EditField( oBtnAdd, oBtnEdit,;
                        cField, @cName, @cType, @nLen, @nDec, @lEditing,;
                        oGet, oType, oLen, oDec )

   REDEFINE BUTTON ID 190 OF oDlg ACTION oLbx:Del()

   REDEFINE GET cDbfName ID 210 OF oDlg

   REDEFINE COMBOBOX oCbx VAR cDriver ;
      ITEMS { "DbfNtx", "DbfCdx", "DbfMdx", "DbfNdx", "DbPx" } ;
      ID 230 OF oDlg

   REDEFINE BUTTON ID 220 OF oDlg ;
      ACTION ( BuildDbf( RTrim( cDbfName ), oLbx, cDriver ),;
               oMruDbfs:Save( cDbfName ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

//----------------------------------------------------------------------------//

static function AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
                          cName, cType, nLen, nDec, lEditing )

   if Empty( cName )
      MsgInfo( "I need a field name", "Sorry" )
   else
      if ! lEditing
         oLbx:Add( xPadR( cName, 100 ) + Chr( 9 ) + cType + ;
                   xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),;
                   oLbx:GetPos() )
			else
         oLbx:Modify( xPadR( cName, 100 ) + Chr( 9 ) + cType + ;
                      xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ) )
         oBtnAdd:SetText( "&Add" )
         oBtnEdit:Enable()
         lEditing = .f.
      endif
      cName = Space( 10 )
      oGet:Refresh()
      oGet:SetFocus()
   endif

return nil

//----------------------------------------------------------------------------//

static function BuildDbf( cDbfName, oLbx, cDriver )

   local aFields := {}
   local n

   if Empty( cDbfName )
      MsgAlert( "I need a DBF name", "Sorry" )
      return nil
   endif

   if Len( oLbx:aItems ) == 0
      MsgAlert( "No fields defined", "Sorry" )
      return nil
   endif

   if At( ".", cDbfName ) == 0
      cDbfName += ".dbf"
   endif

   if File( cDbfName )
      if ! MsgYesNo( "Create it again?", "That DBF already exists" )
         return nil
      endif
   endif

   for n = 1 to Len( oLbx:aItems )
      AAdd( aFields, FldInfo( AllTrim( oLbx:aItems[ n ] ) ) )
   next

   RddSetDefault( cDriver )
   DbCreate( cDbfName, aFields )
   RddSetDefault( "DbfNtx" )

   MsgInfo( "DBF created!", "AllRight" )

return nil

//----------------------------------------------------------------------------//

static function FldInfo( cItem )

return { StrToken( cItem, 1 ),;
         Right( StrToken( cItem, 2 ), 1 ),;
         Val( StrToken( cItem, 3 ) ),;
         Val( StrToken( cItem, 4 ) ) }

//----------------------------------------------------------------------------//

static function EditField( oBtnAdd, oBtnEdit, cField,;
                           cName, cType, nLen, nDec, lEditing,;
                           oName, oType, oLen, oDec )

   if ! Empty( cField )
      oBtnAdd:SetText( "&Replace" )
      oBtnEdit:Disable()
      lEditing = .t.

      cName = StrToken( cField, 1 )
      cType = Right( StrToken( cField, 2 ), 1 )
      nLen  = Val( StrToken( cField, 3 ) )
      nDec  = Val( StrToken( cField, 4 ) )

      oName:Refresh()
      oType:Refresh()
      oLen:Refresh()
      oDec:Refresh()
   else
      MsgInfo( "Select a field to edit", "Please" )
   endif

return nil

//----------------------------------------------------------------------------//

function DbfOpen( cDbfName, cDriver, oMruDbfs )

   local oWndBrw
   local nFilter

   DEFAULT cDriver  := "DbfNtx"
   DEFAULT aDbfBmps := { LoadBitmap( GetResources(), "NoDeleted" ),;
                         LoadBitmap( GetResources(), "Deleted" ) }

   if Empty( cDbfName )
      cDbfName := cGetFile( "Standard dbf (*.dbf) | *.dbf |" + ;
                            "FoxPro cdx (*.dbf) | *.dbf |" + ;
                            "dBase IV mdx (*.dbf) | *.dbf |" + ;
                            "dBase III+ ndx (*.dbf) | *.dbf |" + ;
                            "Paradox db (*.db) | *.db", ;
                            "Select a DataBase to use", 1, "..\samples\*.dbf" )

      #ifndef __HARBOUR__
         cDriver = DRIVERS( IDE_DRIVERS )[ nGetFileFilter() ]
      #else
         cDriver = { "DbfNtx" }
      #endif
   endif

   if ! Empty( cDbfName ) .and. File( cDbfName )

      USE ( cDbfName ) NEW VIA ( cDriver ) SHARED ;
         ALIAS ( cCheckArea( cFileNoExt( cFileNoPath( cDbfName ) ) ) )

      oWndBrw = TWndArea():New( "DataBase: " + cFileNoExt( cFileNoPath( cDbfName ) ),;
                                "DataBase" )  // Icon name

      ACTIVATE WINDOW oWndBrw ;
         VALID ( oMruDbfs:Save( cDBfName ), oWndBrw:oBrw:lCloseArea() )
   else
      MsgAlert( "DBF file not found!" )
   endif

return nil

//----------------------------------------------------------------------------//

CLASS TWndArea FROM TWindow

   DATA   oBrw
   DATA   oTabs

   CLASSDATA lRegistered AS LOGICAL

   METHOD New( cTitle, cIcoName ) CONSTRUCTOR

   METHOD GotFocus()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cTitle, cIcoName ) CLASS TWndArea

   local oFont, oRec, oIndex, cAlias := Alias()

   Super:New(,,,, cTitle )
   ::SetColor( "N/W" )

   DEFINE BUTTONBAR ::oBar _3D SIZE 33, 33 OF Self

   DEFINE BUTTON RESOURCE "New" NOBORDER OF ::oBar ;
      ACTION ( ::oBrw:RecAdd(), ::oBrw:Refresh() ) ;
      MESSAGE "Add a new record" TOOLTIP "New"

   DEFINE BUTTON RESOURCE "Edit" NOBORDER OF ::oBar ;
      MESSAGE "Edit current record" TOOLTIP "Edit"

   DEFINE BUTTON RESOURCE "Del" NOBORDER OF ::oBar ;
      MESSAGE "Delete current record" TOOLTIP "Del";
      ACTION ( ( cAlias )->( DelToggle() ), ::oBrw:DrawSelect() )

   DEFINE BUTTON RESOURCE "Print" GROUP NOBORDER OF ::oBar ;
      TOOLTIP "Print" ;
      ACTION  ::oBrw:Report()

   DEFINE BUTTON RESOURCE "PrjAdd" NOBORDER OF ::oBar ;
      MESSAGE "Add this DataBase to a Project"

   DEFINE BUTTON RESOURCE "Top" GROUP NOBORDER OF ::oBar ;
      ACTION ::oBrw:GoTop() ;
      MESSAGE "Go to first record" TOOLTIP "Top"

   DEFINE BUTTON RESOURCE "Rewind" NOBORDER OF ::oBar ;
      ACTION ::oBrw:PageUp() ;
      MESSAGE "Go to previous page" TOOLTIP "PageUp"

   DEFINE BUTTON RESOURCE "Prev" NOBORDER OF ::oBar ;
      ACTION ::oBrw:GoUp() ;
      MESSAGE "Go previous record" TOOLTIP "Prev"

   DEFINE BUTTON RESOURCE "Next" NOBORDER OF ::oBar ;
      ACTION ::oBrw:GoDown() ;
      MESSAGE "Go to next record" TOOLTIP "Next"

   DEFINE BUTTON RESOURCE "Forward" NOBORDER OF ::oBar ;
      ACTION ::oBrw:PageDown() ;
      MESSAGE "Go to next page" TOOLTIP "PageDown"

   DEFINE BUTTON RESOURCE "Bottom" NOBORDER OF ::oBar ;
      ACTION ::oBrw:GoBottom() ;
      MESSAGE "Go to last record" TOOLTIP "Bottom"

   DEFINE BUTTON RESOURCE "Chain" NOBORDER OF ::oBar GROUP ;
      TOOLTIP "Relation"

   DEFINE BUTTON RESOURCE "Font" NOBORDER GROUP OF ::oBar ;
      ACTION ::oBrw:SelFont() ;
      MESSAGE "Select a new font" TOOLTIP "Font"

   DEFINE BUTTON RESOURCE "Clr" NOBORDER OF ::oBar ;
      ACTION ::oBrw:SelColor() ;
      MESSAGE "Select a new backcolor" TOOLTIP "Color"

   SET MESSAGE OF Self TO "" NOINSET

   ::oClient = TPanel():New()

   @ ::nBottom - ::nTop - 43, 3 TABS ::oTabs ;
      PROMPTS "&Browse", "&Record", "&Indexes", "&Relations", "&Scope" ;
      OF ::oClient SIZE ::nRight - ::nLeft, 18 PIXEL

   ::oClient:oBottom = ::oTabs

   DEFINE MSGITEM oRec OF ::oMsgBar ;
      PROMPT "Rec: 1/" + LTrim( ( cAlias )->( Str( RecCount() ) ) ) ;
      SIZE 90 ACTION DlgGoTo( ::oBrw, oRec )

   DEFINE MSGITEM OF ::oMsgBar ;
      PROMPT ( cAlias )->( RddName() ) SIZE 60

   DEFINE MSGITEM oIndex OF ::oMsgBar ;
      PROMPT "Index: " + ;
             ( cAlias )->( OrdName( ( cAlias )->( IndexOrd() ) ) ) ;
      SIZE 100 ACTION ( Indexes( cAlias ),;
                        oIndex:SetText( ( cAlias )->( OrdName( ;
                        ( cAlias )->( IndexOrd() ) ) ) ) )

   DEFINE FONT oFont NAME "Arial" SIZE 6, 15 BOLD

   @ 34, -1 LISTBOX ::oBrw FIELDS OF ::oClient ;
      ON CHANGE ( If( GetWndAreas() != nil, GetWndAreas():oControl:Refresh(),),;
                  oRec:SetText( "Rec: " + LTrim( ( cAlias )->( Str( RecNo() ) ) ) ;
                                + "/" + LTrim( ( cAlias )->( Str( RecCount() ) ) ) ) ) ;
      SIZE ::nRight - ::nLeft, ::nBottom - ::nTop - 33 - 25 - 18 ;
      FONT oFont PIXEL

   ::oBrw:bLine = { | aTemp | aTemp := _aFields( ::oBrw ),;
                            If( ::oBrw:nColPos == 1, ( AAdd( aTemp, nil ), AIns( aTemp, 1 ),;
                            aTemp[ 1 ] := If( ( cAlias )->( Deleted() ),;
                            aDbfBmps[ 2 ], aDbfBmps[ 1 ] ) ),), aTemp }

   ::oClient:oClient = ::oBrw

   AAdd( ::oBrw:aJustify, .f. )
   AIns( ::oBrw:aJustify, 1 )
   ::oBrw:aJustify[ 1 ] = .f.

   AAdd( ::oBrw:aColSizes, nil )
   AIns( ::oBrw:aColSizes, 1 )
   ::oBrw:aColSizes[ 1 ] = 16

   AAdd( ::oBrw:aHeaders, nil )
   AIns( ::oBrw:aHeaders, 1 )
   ::oBrw:aHeaders[ 1 ] = ""

   ::oBrw:SetFocus()

return nil

//----------------------------------------------------------------------------//

METHOD GotFocus() CLASS TWndArea

   Super:GotFocus()

   ::oBrw:SetFocus()

return 0

//----------------------------------------------------------------------------//

static function DelToggle()

   if RLock()
      if Deleted()
         DbReCall()
      else
         DbDelete()
      endif
      UNLOCK
   endif

return nil

//----------------------------------------------------------------------------//
// Checks for a possible area name conflict

static function cCheckArea( cDbfName )

   local n      := 2
   local cAlias := cDbfName

   while Select( cAlias ) != 0
      cAlias = cDbfName + AllTrim( Str( n++ ) )
   end

return cAlias

//----------------------------------------------------------------------------//
// Remember to use 'exit' procedures to asure that resources are
// freed on a possible application error

exit procedure FreeResources()

   if aDbfBmps != nil
      AEval( aDbfBmps, { | hBmp | DeleteObject( hBmp ) } )
   endif

return

//----------------------------------------------------------------------------//

static function DbfGen( cAlias )

   local cPrg  := "// FiveWin: Automatic code generation " + CRLF + ;
                  "// for " + cAlias + ".dbf" + CRLF + CRLF + ;
                  '#include "FiveWin.ch"' + CRLF + CRLF + ;
                  "//-----------------------------------------" + ;
                  "----------------------------------//" + CRLF + CRLF + ;
                  "function Main()" + CRLF + CRLF + ;
                  "   SET 3DLOOK ON" + CRLF + CRLF + ;
                  '   if ! File( "' + cAlias + '.dbf" )' + CRLF + ;
                  '      DbCreate( "' + cAlias + '",;' + CRLF

   local aInfo := ( cAlias )->( DbStruct() )
   local n, cTempName

   for n = 1 to Len( aInfo )
      cPrg += Space( 20 ) + If( n == 1, "{ ", "  " ) + '{ "' + ;
              aInfo[ n ][ 1 ] + '", "' + ;
              aInfo[ n ][ 2 ] + '", ' + ;
              AllTrim( Str( aInfo[ n ][ 3 ] ) ) + ", " + ;
              AllTrim( Str( aInfo[ n ][ 4 ] ) ) + "}" + ;
              If( n < Len( aInfo ), ",;", " } )" ) + CRLF
   next

   cPrg += "   endif" + CRLF + CRLF + ;
           "   USE " + cAlias + CRLF + ;
           '   Browse( "DataBase: ' + cAlias + ;
           '",, { ||' + cAlias + '->( DbAppend() ) } )' + CRLF + ;
           "   USE" + CRLF + CRLF + ;
           "return nil" + CRLF + CRLF + ;
           "//-----------------------------------------" + ;
           "----------------------------------//"

   MemoWrit( "Programs\" + ;
             ( cTempName := cNewFileName( SubStr( cAlias, 1, 6 ), "prg" ) ),;
             cPrg )

   PrgOpen( "Programs\" + cTempName, oIDE:oMruPrgs )

return nil

//----------------------------------------------------------------------------//

static function DlgGoTo( oBrw, oRec )

   local oDlg, nRec := ( oBrw:cAlias )->( RecNo() )

   DEFINE DIALOG oDlg RESOURCE "GoTo"

   REDEFINE GET nRec ID 110 OF oDlg PICTURE "9999" ;
      VALID If( nRec >= 1 .and. nRec <= ( oBrw:cAlias )->( RecCount() ),;
                .t., ( MsgStop( "Record must be in range 1-" + ;
                Str( ( oBrw:cAlias )->( RecCount() ) ) ), .f. ) )

   REDEFINE BUTTON ID 120 OF oDlg ;
      ACTION ( oDlg:End(), ( oBrw:cAlias )->( DbGoTo( nRec ) ),;
               oBrw:UpStable(),;
               oRec:SetText( "Rec: " + LTrim( Str( nRec ) ) ;
                   + "/" + LTrim( ( oBrw:cAlias )->( Str( RecCount() ) ) ) ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

//----------------------------------------------------------------------------//

static function Indexes( cAlias )

   local oDlg, cIndex, aItems := {}, n

   for n = 1 to 15
      AAdd( aItems, Str( n, 2 ) + Chr( 9 ) + ;
                    ( cAlias )->( OrdName( n ) ) + Chr( 9 ) + ;
                    ( cAlias )->( OrdKey( n ) ) + Chr( 9 ) + ;
                    ( cAlias )->( OrdFor( n ) ) + Chr( 9 ) + ;
                    ( cAlias )->( OrdBagName( n ) ) )
   next


   DEFINE DIALOG oDlg RESOURCE "Indexes"

   REDEFINE LISTBOX cIndex ITEMS aItems ID 110 OF oDlg

   REDEFINE BUTTON ID 140 OF oDlg ACTION IdxBuilder()

   ACTIVATE DIALOG oDlg CENTERED

return nil

//----------------------------------------------------------------------------//
